home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
C64
/
M-More Monthly Disks
/
(c)m7.d64
/
demo.c
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2007-02-04
|
7KB
|
280 lines
1000 REM"Q=DSAVE"@DEMO 64",D0
1010 :
1020 [143] ** UTILITY DEMO **
1030 :
1040 :
1050 IN[178]49152: DL[178]IN[170]3 : BG[178]IN[170]6
1060 DI[178]IN[170]9 : EN[178]IN[170]12: SM[178]IN[170]15
1080 NS[178]IN[170]18: PZ[178]IN[170]21: SR[178]IN[170]24
1100 :
1110 [143] IN - INPUT ROUTINE
1120 [143] DL - INSERT/DELETE IN ARRAYS
1130 [143] BG - BLOCKGET (BILL MACLEAN)
1140 [143] (TRANSACTOR VOL 2, #7)
1150 [143] DI - DISABLE STOP KEY
1160 [143] EN - ENABLE STOP KEY
1180 [143] SM - STRING MODIFY
1190 [143] NS - INSERT STRING FUNCTION
1200 [143] (TRANSACTOR VOL 3, #1)
1210 [143] PZ - POSITION WITHIN STRING
1220 [143] (TRANSACTOR VOL 3, #1)
1222 [143] SR - SORT STRING ARRAY
1224 [143]
1230 :
1240 [143] INPUT ROUTINE.
1250 [143] --------------
1260 [143]
1270 [143] SYS IN,ED,MX,L$
1280 [143]
1290 [143] ED - EDIT CHARACTERISTICS
1300 [143] MX - STRING LENGTH(1 TO 255)
1310 [143] L$ - ANY STRING VARIABLE
1320 [143]
1330 [143] ED - RESULTS
1340 [143] 0 - ALL CHARACTERS ALLOWED
1350 [143] 1 - NUMERIC ONLY
1360 [143] 2 - . + -
1370 [143] 4 - A TO Z (UPPER/LOWER)
1380 [143] 8 - A TO Z (FORCE UPPER)
1390 [143] 16 - BLANK ALLOWED
1400 [143] 32 - Y,N (FORCE UPPER)
1410 [143] 64 - NULL FIELD NOT ALLOWED
1420 [143] 256 - '0' ON NULL INPUT
1430 [143] 512 - 'Y' ON NULL INPUT
1440 [143] 1024 - 'N' ON NULL INPUT
1450 [143] 2048 - ' ' ON NULL INPUT
1460 :
1470 [143] INPUT ROUTINE.
1480 [143] --------------
1490 [143]
1500 [143] THE STRING VARIABLE MUST HAVE
1510 [143] BEEN DEFINED BEFORE THE SYS.
1520 [143]
1530 [143] THE ED VALUES CAN BE OR'D
1540 [143] TOGETHER.
1550 [143] IE. ED=3 IS THE SAME AS
1560 [143] ED=1+2 (NUMERIC AND +.-)
1570 [143]
1580 [143] C.R. ENDS INPUT
1590 [143] DELETE KEY AS USUAL
1600 [143] SHIFT-C.R. DELETES ENTIRE
1610 [143] LINE OF INPUT
1620 [143] " CANNOT BE INPUT
1630 REM
1640 REM IT IS BEST TO RE-ASSIGN THE
1650 REM STRING TO UPPER MEMORY BY
1660 REM L$=L$+""
1670 REM SYS IN,0,25,D1$(2)
1680 REM SYS IN,ED,2,KY$
1690 :
1700 REM INSERT/DELETE ROUTINE.
1710 REM ----------------------
1720 REM
1730 REM USED TO INSERT AN ELEMENT OR
1740 REM DELETE AN ELEMENT FROM ONE
1750 REM OR MORE ARRAYS.
1760 REM
1770 REM SYS DL,SW,PO,EL,A(0),B$(0),ZZ
1780 REM
1790 REM SW - 0=OPEN UP ROOM FOR ONE
1800 REM ELEMENT.
1810 REM 1=DELETE AN ELEMENT.
1820 REM PO - POSITION OF ELEMENT.
1830 REM EL - # OF ELEMENTS (DELETE)
1840 REM # OF ELEMENTS PLUS 1
1850 REM (INSERT)
1860 REM THAT ARE IN THE ARRAY
1870 REM A(0),B$(0),C%(0),...........
1880 REM LIST OF SINGLE DIMEN.
1890 REM ARRAYS (ZERO ELEMENT)
1900 REM ZZ - TERMINATOR. (MUST BE
1910 REM LAST VARIABLE OF SYS)
1920 :
1930 REM BLOCK GET.
1940 REM ----------
1950 REM
1960 REM SYS BG,FN,L$
1970 REM
1980 REM TAKES THE PLACE OF AN INPUT#FN
1990 REM STATEMENT.
2000 REM FN - FILE NUMBER
2010 REM L$ - STRING READ INTO
2020 REM
2030 REM OPEN 1,8,3,"0:TEST,S,R"
2040 REM FOR I=1 TO 10
2050 REM SYS BG,1,L$
2060 REM D1$(I)=L$+""
2070 REM NEXT I
2080 REM
2090 REM THIS WILL READ FROM ZERO TO
2100 REM 255 BYTES FROM A FILE. (CR)
2110 REM TERMINATES INPUT. COMMA DOES
2120 REM NOT AFFECT INPUT OF DATA.
2130 :
2140 REM DISABLE STOP KEY.
2150 REM -----------------
2160 REM
2170 REM SYS DI
2180 REM
2190 REM DISABLES THE STOP KEY BUT
2200 REM ALLOWS THE CLOCK TO RUN.
2210 REM
2300 REM ENABLE STOP KEY.
2310 REM ----------------
2320 REM
2330 REM SYS EN
2340 REM
2350 REM STOP KEY WILL NOW WORK.
2360 :
2370 REM STRING MODIFY.
2380 REM --------------
2390 REM
2400 REM SYS SM,P,L$
2410 REM
2420 REM P=1 CONVERT TO ASCII
2430 REM P=2 FORCE UPPER CASE
2440 REM
2450 REM SYS SM,2,D1$(15) WILL CONVERT
2460 REM THE ALPHA IN THE STRING
2470 REM TO UPPER CASE.
2480 REM
2490 REM SYS SM,1,K$ WILL CONVERT THE
2500 REM CHARACTERS IN K$ TO ASCII
2510 REM CHARACTERS. THIS WILL ALLOW
2520 REM PRINTING TO CENTRONICS
2530 REM PRINTERS, TO THE N.E.C.
2540 REM SPINWRITER ETC.
2550 REM
2560 :
2570 REM INSERT STRING FUNCTION
2580 REM ----------------------
2590 REM
2600 REM SYS NS,A$,B$,P
2610 REM
2620 REM THIS WILL INSERT THE STRING
2630 REM A$ INTO B$ AT POSITION P.
2640 REM
2650 REM THE PROGRAM MUST MAKE SURE
2660 REM THAT THE STRING BEING
2670 REM INSERTED DOES NOT OVERFLOW
2680 REM THE END OF B$.
2690 REM
2700 REM LEN(A$)+P <= LEN(B$) AND P>0
2710 REM
2720 :
2730 REM POSITION WITHIN STRING
2740 REM ----------------------
2750 REM
2760 REM SYS PZ,A$,B$
2770 REM
2780 REM THIS WILL SEARCH FOR THE 1ST
2790 REM OCCURANCE OF A$ WITHIN B$.
2800 REM
2810 REM PEEK(51200) = 0 IF NOT FOUND
2820 REM PEEK(51200) = POSITION WITHIN
2830 REM B$ THAT A$ OCCURS.
2840 REM
2850 :
2860 REM SORT A STRING ARRAY
2865 REM -------------------
2870 REM
2875 REM SYS SR,K$(0)
2880 REM
2885 REM WHERE K$ IS A SINGLE DIMENSION
2890 REM STRING ARRAY AND THE ZERO'TH
2895 REM ELEMENT IS REFERENCED IN THE
2900 REM SUBROUTINE CALL.
2905 REM
2910 REM ALL ELEMENTS ARE SORTED. 'NULL'
2915 REM STRINGS ARE PUT AT THE END
2920 REM OF THE STRING ARRAY.
2925 REM
2930 REM THE ZERO'TH ELEMENT IS ALWAYS
2935 REM INCLUDED IN THE SORT. THIS
2940 REM MEANS THAT AFTER SORTING,
2945 REM K$(0) WILL CONTAIN THE
2950 REM SMALLEST VALUE AND IF THERE
2955 REM ARE 'N' VALID ITEMS IN THE
2960 REM STRING ARRAY, K$(N-1) WILL
2965 REM HOLD THE LARGEST VALUE.
2970 REM
2975 REM TO FORCE THE SORT NOT TO USE
2980 REM THE ZERO'TH ARRAY POSITION
2985 REM SET IT TO THE FOLLOWING:
2990 REM K$(0)=CHR$(1)
2995 REM
3000 :
3001 SYS DI
3002 PRINT CHR$(8);CHR$(14)
3010 PO$=""
3030 PRINT"[147] [201][206][208][213][212] [196][197][205][207] 1": L$=""
3040 PRINT LEFT$(PO$,9);"[197][196]: ";
3050 SYS IN,65,4,L$
3060 ED=VAL(L$)
3070 IF ED=9999 THEN 4000
3080 PRINT LEFT$(PO$,11);"[205][216]: ";
3090 SYS IN,65,3,L$
3100 MX=VAL(L$)
3110 IF MX=0 OR MX>148 THEN 3080
3120 PRINT LEFT$(PO$,14);"[201]NPUT: ";
3130 SYS IN,ED,MX,L$: PRINT
3140 PRINT PO$;L$;
3150 GET A$:IF A$="" THEN 3150
3160 PRINT PO$;" ";
3170 GOTO 3010
4000 :
4010 H1$(1)=LEFT$(PO$,10)+"1[146] [206]AME: "
4020 H1$(2)=LEFT$(PO$,11)+"2[146] [193]DR1: "
4030 H1$(3)=LEFT$(PO$,12)+"3[146] [193]DR2: "
4040 H1$(4)=LEFT$(PO$,13)+"4[146] [193]DR3: "
4050 H1$(5)=LEFT$(PO$,14)+"5[146] [208]COD: "
4060 H1$(6)=LEFT$(PO$,15)+"6[146] [200]OME: "
4070 H1$(7)=LEFT$(PO$,16)+"7[146] [194]USS: "
4080 H1$(8)=LEFT$(PO$,17)+"8[146] [195]ODE: "
4090 LE%(1)=32: ED%(1)=0
4100 LE%(2)=32: ED%(2)=0
4110 LE%(3)=32: ED%(3)=0
4120 LE%(4)=32: ED%(4)=0
4130 LE%(5)=6 : ED%(5)=9
4140 LE%(6)=19: ED%(6)=0
4150 LE%(7)=19: ED%(7)=0
4160 LE%(8)=20: ED%(8)=27
5000 :
5010 PRINT"[147] [201][206][208][213][212] [196][197][205][207] 2": L$=""
5020 FOR I=1 TO 8
5030 PRINT H1$(I);
5040 ED=ED%(I): MX=LE%(I)
5050 SYS IN,ED,MX,L$
5060 D1$(I)=L$+""
5070 NEXT I
5080 GET A$: IF A$="" THEN 5080
6000 :
6010 PRINT"[147] [201][206][208][213][212] [196][197][205][207] 3": L$=""
6020 FOR I=1 TO 8
6030 PRINT H1$(I);D1$(I);
6040 NEXT I
6050 PRINT PO$;"[198]IELD #:[146] ";
6060 SYS IN,1,1,L$: L=VAL(L$)
6070 IF L=0 THEN 7000
6080 IF L>8 THEN 6010
6090 PRINT PO$;" ";
6100 PRINT H1$(L);
6110 ED=ED%(L): MX=LE%(L)
6120 SYS IN,ED,MX,L$
6130 D1$(L)=L$+""
6140 GOTO 6010
7000 :
7010 PRINT"[147] [211][212][210][201][206][199] [205][207][196][201][198][217]"
7020 PRINT LEFT$(PO$,8);"[213][208][208][197][210][160]CASE";
7030 PRINT LEFT$(PO$,10);"[211]TRING: ";
7040 SYS IN,0,10,L$
7050 SYS SM,2,L$
7060 PRINT LEFT$(PO$,12);" ";L$
7070 PRINT LEFT$(PO$,16);"[193][211][195][201][201]";
7080 PRINT LEFT$(PO$,18);"[211]TRING: ";
7090 SYS IN,0,10,L$
7100 SYS SM,1,L$
7110 PRINT LEFT$(PO$,20);" ";L$
7120 FOR I=1 TO 10000: NEXT I
7130 SYS EN: PRINT CHR$(9);CHR$(142)